home *** CD-ROM | disk | FTP | other *** search
/ PC Open 98 / PC Open 98 CD1.bin / INTERNET / EMAIL / pop file / setup.exe / Proxy / POP3.pm next >
Encoding:
Perl POD Document  |  2004-03-10  |  29.7 KB  |  726 lines
  1. # POPFILE LOADABLE MODULE
  2. package Proxy::POP3;
  3.  
  4. use Proxy::Proxy;
  5. @ISA = ("Proxy::Proxy");
  6.  
  7. # ---------------------------------------------------------------------------------------------
  8. #
  9. # This module handles proxying the POP3 protocol for POPFile.
  10. #
  11. # Copyright (c) 2001-2003 John Graham-Cumming
  12. #
  13. #   This file is part of POPFile
  14. #
  15. #   POPFile is free software; you can redistribute it and/or modify
  16. #   it under the terms of the GNU General Public License as published by
  17. #   the Free Software Foundation; either version 2 of the License, or
  18. #   (at your option) any later version.
  19. #
  20. #   POPFile is distributed in the hope that it will be useful,
  21. #   but WITHOUT ANY WARRANTY; without even the implied warranty of
  22. #   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23. #   GNU General Public License for more details.
  24. #
  25. #   You should have received a copy of the GNU General Public License
  26. #   along with POPFile; if not, write to the Free Software
  27. #   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
  28. #
  29. #   Modified by     Sam Schinke (sschinke@users.sourceforge.net)
  30. #
  31. # ---------------------------------------------------------------------------------------------
  32.  
  33. use strict;
  34. use warnings;
  35. use locale;
  36.  
  37. # A handy variable containing the value of an EOL for networks
  38. my $eol = "\015\012";
  39.  
  40. #----------------------------------------------------------------------------
  41. # new
  42. #
  43. #   Class new() function
  44. #----------------------------------------------------------------------------
  45. sub new
  46. {
  47.     my $type = shift;
  48.     my $self = Proxy::Proxy->new();
  49.  
  50.     # Must call bless before attempting to call any methods
  51.  
  52.     bless $self, $type;
  53.  
  54.     $self->name( 'pop3' );
  55.  
  56.     $self->{child_} = \&child__;
  57.     $self->{connection_timeout_error_} = '-ERR no response from mail server';
  58.     $self->{connection_failed_error_}  = '-ERR can\'t connect to';
  59.     $self->{good_response_}            = '^\+OK';
  60.  
  61.     return $self;
  62. }
  63.  
  64. # ---------------------------------------------------------------------------------------------
  65. #
  66. # initialize
  67. #
  68. # Called to initialize the POP3 proxy module
  69. #
  70. # ---------------------------------------------------------------------------------------------
  71. sub initialize
  72. {
  73.     my ( $self ) = @_;
  74.  
  75.     # Enabled by default
  76.     $self->config_( 'enabled', 1);
  77.  
  78.     # By default we don't fork on Windows
  79.     $self->config_( 'force_fork', ($^O eq 'MSWin32')?0:1 );
  80.  
  81.     # Default ports for POP3 service and the user interface
  82.     $self->config_( 'port', 110 );
  83.  
  84.     # There is no default setting for the secure server
  85.     $self->config_( 'secure_server', '' );
  86.     $self->config_( 'secure_port', 110 );
  87.  
  88.     # Only accept connections from the local machine for POP3
  89.     $self->config_( 'local', 1 );
  90.  
  91.     # Whether to do classification on TOP as well
  92.     $self->config_( 'toptoo', 0 );
  93.  
  94.     # The separator within the POP3 username is :
  95.     $self->config_( 'separator', ':' );
  96.  
  97.     # The welcome string from the proxy is configurable
  98.     $self->config_( 'welcome_string', "POP3 POPFile ($self->{version_}) server ready" );
  99.  
  100.     return $self->SUPER::initialize();;
  101. }
  102.  
  103. # ---------------------------------------------------------------------------------------------
  104. #
  105. # start
  106. #
  107. # ---------------------------------------------------------------------------------------------
  108. sub start
  109. {
  110.     my ( $self ) = @_;
  111.  
  112.     # If we are not enabled then no further work happens in this module
  113.  
  114.     if ( $self->config_( 'enabled' ) == 0 ) {
  115.         return 2;
  116.     }
  117.  
  118.     # Tell the user interface module that we having a configuration
  119.     # item that needs a UI component
  120.  
  121.     $self->register_configuration_item_( 'configuration',              # PROFILE BLOCK START
  122.                                          'pop3_port',
  123.                                          $self );                      # PROFILE BLOCK STOP
  124.  
  125.     $self->register_configuration_item_( 'configuration',              # PROFILE BLOCK START
  126.                                          'pop3_separator',
  127.                                          $self );                      # PROFILE BLOCK STOP
  128.  
  129.     $self->register_configuration_item_( 'configuration',              # PROFILE BLOCK START
  130.                                          'pop3_force_fork',
  131.                                          $self );                      # PROFILE BLOCK STOP
  132.  
  133.     $self->register_configuration_item_( 'security',                   # PROFILE BLOCK START
  134.                                          'pop3_local',
  135.                                          $self );                      # PROFILE BLOCK STOP
  136.  
  137.     $self->register_configuration_item_( 'chain',                      # PROFILE BLOCK START
  138.                                          'pop3_secure_server',
  139.                                          $self );                      # PROFILE BLOCK STOP
  140.  
  141.     $self->register_configuration_item_( 'chain',                      # PROFILE BLOCK START
  142.                                          'pop3_secure_server_port',
  143.                                          $self );                      # PROFILE BLOCK STOP
  144.  
  145.     if ( $self->config_( 'welcome_string' ) =~ /^POP3 POPFile \(v\d+\.\d+\.\d+\) server ready$/ ) {
  146.         $self->config_( 'welcome_string', "POP3 POPFile ($self->{version_}) server ready" );
  147.     }
  148.  
  149.     return $self->SUPER::start();
  150. }
  151.  
  152. # ---------------------------------------------------------------------------------------------
  153. #
  154. # child__
  155. #
  156. # The worker method that is called when we get a good connection from a client
  157. #
  158. # $client         - an open stream to a POP3 client
  159. # $download_count - The unique download count for this session
  160. # $pipe           - The pipe to the parent process to send messages to
  161. # $ppipe          - 0 or the parent's end of the pipe
  162. # $pid            - 0 if this is a child process
  163. # $session        - API session key
  164. #
  165. # ---------------------------------------------------------------------------------------------
  166. sub child__
  167. {
  168.     my ( $self, $client, $download_count, $pipe, $ppipe, $pid, $session ) = @_;
  169.  
  170.     # Hash of indexes of downloaded messages
  171.  
  172.     my %downloaded;
  173.  
  174.     # The handle to the real mail server gets stored here
  175.  
  176.     my $mail;
  177.  
  178.     # Tell the client that we are ready for commands and identify our version number
  179.  
  180.     $self->tee_( $client, "+OK " . $self->config_( 'welcome_string' ) . "$eol" );
  181.  
  182.     # Retrieve commands from the client and process them until the client disconnects or
  183.     # we get a specific QUIT command
  184.  
  185.     while  ( <$client> ) {
  186.         my $command;
  187.  
  188.         $command = $_;
  189.  
  190.         # Clean up the command so that it has a nice clean $eol at the end
  191.  
  192.         $command =~ s/(\015|\012)//g;
  193.  
  194.         $self->log_( "Command: --$command--" );
  195.  
  196.         # The USER command is a special case because we modify the syntax of POP3 a little
  197.         # to expect that the username being passed is actually of the form host:username where
  198.         # host is the actual remote mail server to contact and username is the username to
  199.         # pass through to that server and represents the account on the remote machine that we
  200.         # will pull email from.  Doing this means we can act as a proxy for multiple mail clients
  201.         # and mail accounts
  202.  
  203.         my $user_command = 'USER (.+?)(:(\d+))?' . $self->config_( 'separator' ) . '(.+)';
  204.         if ( $command =~ /$user_command/i ) {
  205.             if ( $1 ne '' )  {
  206.                 print $pipe "LOGIN:$4$eol";
  207.                 flush $pipe;
  208.                 $self->yield_( $ppipe, $pid );
  209.  
  210.                 if ( $mail = $self->verify_connected_( $mail, $client, $1, $3 || 110 ) )  {
  211.  
  212.                     # Pass through the USER command with the actual user name for this server,
  213.                     # and send the reply straight to the client
  214.  
  215.                     last if ( $self->echo_response_($mail, $client, 'USER ' . $4 ) == 2 );
  216.                 } else {
  217.  
  218.                     # If the login fails then we want to continue in the unlogged in state
  219.                     # so that clients can send us the QUIT command
  220.  
  221.                     next;
  222.                 }
  223.             }
  224.  
  225.             next;
  226.         }
  227.  
  228.         # User is issuing the APOP command to start a session with the remote server
  229.  
  230.         if ( $command =~ /APOP (.+?):((.+):)?([^ ]+) (.*)/i ) {
  231.             if ( $mail = $self->verify_connected_( $mail, $client,  $1, $3 || 110 ) )  {
  232.  
  233.                 # Pass through the APOP command with the actual user name for this server,
  234.                 # and send the reply straight to the client
  235.  
  236.                 last if ( $self->echo_response_($mail, $client, "APOP $4 $5" ) == 2 );
  237.             } else {
  238.                 next;
  239.             }
  240.  
  241.             next;
  242.         }
  243.  
  244.         # Secure authentication
  245.  
  246.         if ( $command =~ /AUTH ([^ ]+)/ ) {
  247.             if ( $self->config_( 'secure_server' ) ne '' )  {
  248.                 if ( $mail = $self->verify_connected_( $mail, $client,  $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) )  {
  249.  
  250.                     # Loop until we get -ERR or +OK
  251.  
  252.                     my ( $response, $ok ) = $self->get_response_( $mail, $client, $command );
  253.  
  254.                     while ( ( ! ( $response =~ /\+OK/ ) ) && ( ! ( $response =~ /-ERR/ ) ) ) {
  255.                         my $auth;
  256.                         $auth = <$client>;
  257.                         $auth =~ s/(\015|\012)$//g;
  258.                         ( $response, $ok ) = $self->get_response_( $mail, $client, $auth );
  259.                     }
  260.                 } else {
  261.                     next;
  262.                 }
  263.             } else {
  264.                 $self->tee_(  $client, "-ERR No secure server specified$eol" );
  265.             }
  266.  
  267.             next;
  268.         }
  269.  
  270.         if ( $command =~ /AUTH/ ) {
  271.             if ( $self->config_( 'secure_server' ) ne '' )  {
  272.                 if ( $mail = $self->verify_connected_( $mail, $client,  $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) )  {
  273.                     my $response = $self->echo_response_($mail, $client, "AUTH" );
  274.                     last if ( $response == 2 );
  275.                     if ( $response == 0 ) {
  276.                         $self->echo_to_dot_( $mail, $client );
  277.                     }
  278.                 } else {
  279.                     next;
  280.                 }
  281.             } else {
  282.                 $self->tee_(  $client, "-ERR No secure server specified$eol" );
  283.             }
  284.  
  285.             next;
  286.         }
  287.  
  288.         # The client is requesting a LIST/UIDL of the messages
  289.  
  290.         if ( ( $command =~ /LIST ?(.*)?/i ) ||                            # PROFILE BLOCK START
  291.              ( $command =~ /UIDL ?(.*)?/i ) ) {                           # PROFILE BLOCK STOP
  292.             my $response = $self->echo_response_($mail, $client, $command );
  293.             last if ( $response == 2 );
  294.             if ( $response == 0 ) {
  295.                 $self->echo_to_dot_( $mail, $client ) if ( $1 eq '' );
  296.             }
  297.  
  298.             next;
  299.         }
  300.  
  301.         # TOP handling is rather special because we have three cases that we handle
  302.         #
  303.         # 1. If the client sends TOP x 99999999 then it is most likely to be
  304.         #    fetchmail and the intent of fetchmail is to actually get the message
  305.         #    but for its own reasons it does not use RETR.  We use RETR as the clue
  306.         #    to place a message in the history, so we have a hack.  If the client
  307.         #    looks like fetchmail then TOP x 99999999 is actually implemented
  308.         #    using RETR
  309.         #
  310.         # 2. The toptoo configuration controls whether email downloaded using the
  311.         #    TOP command is classified or not (It may be downloaded and cached for
  312.         #    bandwidth efficiency, and thus appear in the history).
  313.         #    There are two cases:
  314.         #
  315.         # 2a If toptoo is 0 then POPFile will pass a TOP from the client through
  316.         #    as a TOP and do no classification on the message.
  317.         #
  318.         # 2b If toptoo is 1 then POPFile first does a RETR on the message and
  319.         #    saves it in the history so that it can get the classification on the
  320.         #    message which is stores in $class.  Then it gets the message again
  321.         #    by sending the TOP command and passing the result through
  322.         #    classify_and_modify passing in the $class determined above.  This means
  323.         #    that the message gets the right classification and the client only
  324.         #    gets the headers requested plus so many lines of body, but they will
  325.         #    get subject modification, and the XTC and XPL headers add.  Note that
  326.         #    TOP always returns the full headers and then n lines of the body so
  327.         #    we are guaranteed to be able to do our header modifications.
  328.         #
  329.         #    NOTE messages retrieved using TOPTOO are visible in the history as they
  330.         #    are "cached" to avoid requiring repeated downloads if the client issues
  331.         #    a RETR for the message in the same session
  332.         #
  333.         #    NOTE using toptoo=1 on a slow link could cause performance problems, in
  334.         #    cases where only the headers, but not classification, is required.
  335.         #    toptoo=1 is, however, appropriate for normal use via a mail client and
  336.         #    won't significantly increase bandwidth unless the mail client is selectively
  337.         #    downloading messages based on non-classification data in the TOP headers.
  338.  
  339.         if ( $command =~ /TOP (.*) (.*)/i ) {
  340.             my $count = $1;
  341.  
  342.             if ( $2 ne '99999999' )  {
  343.                 if ( $self->config_( 'toptoo' ) == 1 ) {
  344.                     my $response = $self->echo_response_($mail, $client, "RETR $count" );
  345.                     last if ( $response == 2 );
  346.                     if ( $response == 0 ) {
  347.  
  348.                         # Classify without echoing to client, saving file for later RETR's
  349.  
  350.                         my ( $class, $history_file ) = $self->{classifier__}->classify_and_modify( $session, $mail, $client, $download_count, $count, 0, '', 0 );
  351.  
  352.                         $downloaded{$count} = 1;
  353.  
  354.                         # Note that the 1 here indicates that echo_response_ does not send the response to the
  355.                         # client.  The +OK has already been sent by the RETR
  356.  
  357.                         $response = $self->echo_response_( $mail, $client, $command, 1 );
  358.                         last if ( $response == 2 );
  359.                         if ( $response == 0 ) {
  360.  
  361.                             # Classify with pre-defined class, without saving, echoing to client
  362.  
  363.                             $self->{classifier__}->classify_and_modify( $session, $mail, $client, $download_count, $count, 1, $class, 1 );
  364.  
  365.                             # Tell the parent that we just handled a mail
  366.  
  367.                             print $pipe "CLASS:$class $session$eol";
  368.                             print $pipe "NEWFL:$history_file$eol";
  369.                             flush $pipe;
  370.                             $self->yield_( $ppipe, $pid );
  371.                         }
  372.                     }
  373.                 } else {
  374.                     my $response = $self->echo_response_($mail, $client, $command );
  375.                     last if ( $response == 2 );
  376.                     if ( $response == 0 ) {
  377.                         $self->echo_to_dot_( $mail, $client );
  378.             }
  379.                 }
  380.  
  381.                 next;
  382.             }
  383.  
  384.             # Note the fall through here.  Later down the page we look for TOP x 99999999 and
  385.             # do a RETR instead
  386.         }
  387.  
  388.         # The CAPA command
  389.  
  390.         if ( $command =~ /CAPA/i ) {
  391.             if ( $mail || $self->config_( 'secure_server' ) ne '' )  {
  392.                 if ( $mail || ( $mail = $self->verify_connected_( $mail, $client, $self->config_( 'secure_server' ), $self->config_( 'secure_port' ) ) ) )  {
  393.                     my $response = $self->echo_response_($mail, $client, "CAPA" );
  394.                     last if ( $response == 2 );
  395.                     if ( $response == 0 ) {
  396.                         $self->echo_to_dot_( $mail, $client );
  397.             }
  398.                 } else {
  399.                     next;
  400.                 }
  401.             } else {
  402.                 $self->tee_(  $client, "-ERR No secure server specified$eol" );
  403.             }
  404.  
  405.             next;
  406.         }
  407.  
  408.         # The HELO command results in a very simple response from us.  We just echo that
  409.         # we are ready for commands
  410.  
  411.         if ( $command =~ /HELO/i ) {
  412.             $self->tee_(  $client, "+OK HELO POPFile Server Ready$eol" );
  413.             next;
  414.         }
  415.  
  416.         # In the case of PASS, NOOP, XSENDER, STAT, DELE and RSET commands we simply pass it through to
  417.         # the real mail server for processing and echo the response back to the client
  418.  
  419.         if ( ( $command =~ /PASS (.*)/i )    ||                  # PROFILE BLOCK START
  420.              ( $command =~ /NOOP/i )         ||
  421.              ( $command =~ /STAT/i )         ||
  422.              ( $command =~ /XSENDER (.*)/i ) ||
  423.              ( $command =~ /DELE (.*)/i )    ||
  424.              ( $command =~ /RSET/i ) ) {                         # PROFILE BLOCK STOP
  425.             last if ( $self->echo_response_($mail, $client, $command ) == 2 );
  426.             next;
  427.         }
  428.  
  429.         # The client is requesting a specific message.
  430.         # Note the horrible hack here where we detect a command of the form TOP x 99999999 this
  431.         # is done so that fetchmail can be used with POPFile.
  432.  
  433.         if ( ( $command =~ /RETR (.*)/i ) || ( $command =~ /TOP (.*) 99999999/i ) )  {
  434.             my $count = $1;
  435.             my $class;
  436.  
  437.             # With a path
  438.  
  439.             my $file = $self->{classifier__}->history_filename($download_count, $count, undef, 1);
  440.  
  441.             # without a path
  442.  
  443.             my $short_file = $self->{classifier__}->history_filename($download_count, $count, undef, 0);
  444.  
  445.             #$self->log_( "Class file $file shortens to $short_file" );
  446.  
  447.             if (defined($downloaded{$count}) && open( RETRFILE, "<$file" ) ) {
  448.  
  449.                 # act like a network stream
  450.  
  451.                 binmode RETRFILE;
  452.  
  453.                 # File has been fetched and classified already
  454.  
  455.                 $self->log_( "Printing message from cache" );
  456.  
  457.                 # Give the client an +OK:
  458.  
  459.                 $self->tee_( $client, "+OK " . ( -s $file ) . " bytes from POPFile cache$eol" );
  460.  
  461.                 # Load the last classification
  462.  
  463.                 my ( $reclassified, $bucket, $usedtobe, $magnet) = $self->{classifier__}->history_read_class($short_file);
  464.  
  465.                 if ( $bucket ne 'unknown class' ) {
  466.  
  467.                     # echo file, inserting known classification, without saving
  468.  
  469.                     ($class, undef) = $self->{classifier__}->classify_and_modify( $session, \*RETRFILE, $client, $download_count, $count, 1, $bucket );
  470.                     print $client ".$eol";
  471.  
  472.                 } else {
  473.  
  474.                     # If the class wasn't saved properly, classify from disk normally
  475.  
  476.                     ($class, undef) = $self->{classifier__}->classify_and_modify( $session, \*RETRFILE, $client, $download_count, $count, 1, '' );
  477.                     print $client ".$eol";
  478.  
  479.                     print $pipe "CLASS:$class $session$eol";
  480.                     flush $pipe;
  481.                     $self->yield_( $ppipe, $pid );
  482.                 }
  483.  
  484.                 close RETRFILE;
  485.             } else {
  486.  
  487.                 # Retrieve file directly from the server
  488.  
  489.                 # Get the message from the remote server, if there's an error then we're done, but if not then
  490.                 # we echo each line of the message until we hit the . at the end
  491.  
  492.                 my $response = $self->echo_response_($mail, $client, $command );
  493.                 last if ( $response == 2 );
  494.                 if ( $response == 0 ) {
  495.                     my $history_file;
  496.                     ( $class, $history_file ) = $self->{classifier__}->classify_and_modify( $session, $mail, $client, $download_count, $count, 0, '' );
  497.  
  498.                     # Tell the parent that we just handled a mail
  499.  
  500.                     print $pipe "NEWFL:$history_file$eol";
  501.                     print $pipe "CLASS:$class $session$eol";
  502.                     flush $pipe;
  503.                     $self->yield_( $ppipe, $pid );
  504.  
  505.                     # Note locally that file has been retrieved if the full thing has been saved
  506.                     # to disk
  507.  
  508.                     $downloaded{$count} = 1;
  509.                 }
  510.             }
  511.  
  512.             next;
  513.         }
  514.  
  515.         # The mail client wants to stop using the server, so send that message through to the
  516.         # real mail server, echo the response back up to the client and exit the while.  We will
  517.         # close the connection immediately
  518.  
  519.         if ( $command =~ /QUIT/i ) {
  520.             if ( $mail )  {
  521.                 last if ( $self->echo_response_( $mail, $client, $command ) == 2 );
  522.                 close $mail;
  523.             } else {
  524.                 $self->tee_( $client, "+OK goodbye$eol" );
  525.             }
  526.             last;
  527.         }
  528.  
  529.         # Don't know what this is so let's just pass it through and hope for the best
  530.  
  531.         if ( $mail && $mail->connected )  {
  532.             last if ( $self->echo_response_($mail, $client, $command ) == 2 );
  533.             next;
  534.         } else {
  535.             $self->tee_(  $client, "-ERR unknown command or bad syntax$eol" );
  536.             next;
  537.         }
  538.  
  539.     }
  540.  
  541.     if ( defined( $mail ) ) {
  542.         $self->done_slurp_( $mail );
  543.         close $mail;
  544.     }
  545.  
  546.     close $client;
  547.     print $pipe "CMPLT$eol";
  548.     flush $pipe;
  549.     $self->yield_( $ppipe, $pid );
  550.     close $pipe;
  551.  
  552.     if ( $pid != 0 ) {
  553.         $self->log_( "POP3 forked child done" );
  554.     } else {
  555.         $self->log_( "POP3 proxy done" );
  556.     }
  557. }
  558.  
  559. # ---------------------------------------------------------------------------------------------
  560. #
  561. # configure_item
  562. #
  563. #    $name            The name of the item being configured, was passed in by the call
  564. #                     to register_configuration_item
  565. #    $language        Reference to the hash holding the current language
  566. #    $session_key     The current session key
  567. #
  568. #  Must return the HTML for this item
  569. # ---------------------------------------------------------------------------------------------
  570.  
  571. sub configure_item
  572. {
  573.     my ( $self, $name, $language, $session_key ) = @_;
  574.  
  575.     my $body;
  576.  
  577.     # POP3 Listen Port widget
  578.     if ( $name eq 'pop3_port' ) {
  579.         $body .= "<form action=\"/configuration\">\n";
  580.         $body .= "<label class=\"configurationLabel\" for=\"configPopPort\">$$language{Configuration_POP3Port}:</label><br />\n";
  581.         $body .= "<input name=\"pop3_port\" type=\"text\" id=\"configPopPort\" value=\"" . $self->config_( 'port' ) . "\" />\n";
  582.         $body .= "<input type=\"submit\" class=\"submit\" name=\"update_pop3_port\" value=\"$$language{Apply}\" />\n";
  583.         $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  584.     }
  585.  
  586.     # Separator Character widget
  587.     if ( $name eq 'pop3_separator' ) {
  588.         $body .= "\n<form action=\"/configuration\">\n";
  589.         $body .= "<label class=\"configurationLabel\" for=\"configSeparator\">$$language{Configuration_POP3Separator}:</label><br />\n";
  590.         $body .= "<input name=\"pop3_separator\" id=\"configSeparator\" type=\"text\" value=\"" . $self->config_( 'separator' ) . "\" />\n";
  591.         $body .= "<input type=\"submit\" class=\"submit\" name=\"update_pop3_separator\" value=\"$$language{Apply}\" />\n";
  592.         $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  593.     }
  594.  
  595.     # Accept POP3 from Remote Machines widget
  596.     if ( $name eq 'pop3_local' ) {
  597.         $body .= "<span class=\"securityLabel\">$$language{Security_POP3}:</span><br />\n";
  598.  
  599.         $body .= "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" summary=\"\"><tr><td nowrap=\"nowrap\">\n";
  600.         if ( $self->config_( 'local' ) == 1 ) {
  601.             $body .= "<form class=\"securitySwitch\" action=\"/security\">\n";
  602.             $body .= "<span class=\"securityWidgetStateOff\">$$language{Security_NoStealthMode}</span>\n";
  603.             $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"securityAcceptPOP3On\" name=\"toggle\" value=\"$$language{ChangeToYes}\" />\n";
  604.             $body .= "<input type=\"hidden\" name=\"pop3_local\" value=\"1\" />\n";
  605.             $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  606.         } else {
  607.             $body .= "<form class=\"securitySwitch\" action=\"/security\">\n";
  608.             $body .= "<span class=\"securityWidgetStateOn\">$$language{Yes}</span>\n";
  609.             $body .= "<input type=\"submit\" class=\"toggleOff\" id=\"securityAcceptPOP3Off\" name=\"toggle\" value=\"$$language{ChangeToNo} (Stealth Mode)\" />\n";
  610.             $body .= "<input type=\"hidden\" name=\"pop3_local\" value=\"2\" />\n";
  611.             $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  612.         }
  613.         $body .= "</td></tr></table>\n";
  614.      }
  615.  
  616.     # Secure Server widget
  617.     if ( $name eq 'pop3_secure_server' ) {
  618.         $body .= "<form action=\"/security\">\n";
  619.         $body .= "<label class=\"securityLabel\" for=\"securitySecureServer\">$$language{Security_SecureServer}:</label><br />\n";
  620.         $body .= "<input type=\"text\" name=\"server\" id=\"securitySecureServer\" value=\"" . $self->config_( 'secure_server' ) . "\" />\n";
  621.         $body .= "<input type=\"submit\" class=\"submit\" name=\"update_server\" value=\"$$language{Apply}\" />\n";
  622.         $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  623.     }
  624.  
  625.     # Secure Port widget
  626.     if ( $name eq 'pop3_secure_server_port' ) {
  627.         $body .= "<form action=\"/security\">\n";
  628.         $body .= "<label class=\"securityLabel\" for=\"securitySecurePort\">$$language{Security_SecurePort}:</label><br />\n";
  629.         $body .= "<input type=\"text\" name=\"sport\" id=\"securitySecurePort\" value=\"" . $self->config_( 'secure_port' ) . "\" />\n";
  630.         $body .= "<input type=\"submit\" class=\"submit\" name=\"update_sport\" value=\"$$language{Apply}\" />\n";
  631.         $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  632.     }
  633.  
  634.     if ( $name eq 'pop3_force_fork' ) {
  635.         $body .= "<span class=\"configurationLabel\">$$language{Configuration_POPFork}:</span><br />\n";
  636.         $body .= "<table border=\"0\" cellpadding=\"0\" cellspacing=\"0\" summary=\"\"><tr><td nowrap=\"nowrap\">\n";
  637.  
  638.         if ( $self->config_( 'force_fork' ) == 0 ) {
  639.             $body .= "<form action=\"/configuration\">\n";
  640.             $body .= "<span class=\"securityWidgetStateOff\">$$language{No}</span>\n";
  641.             $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"windowTrayIconOn\" name=\"toggle\" value=\"$$language{ChangeToYes}\" />\n";
  642.             $body .= "<input type=\"hidden\" name=\"pop3_force_fork\" value=\"1\" />\n";
  643.             $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  644.         } else {
  645.             $body .= "<form action=\"/configuration\">\n";
  646.             $body .= "<span class=\"securityWidgetStateOn\">$$language{Yes}</span>\n";
  647.             $body .= "<input type=\"submit\" class=\"toggleOn\" id=\"windowTrayIconOff\" name=\"toggle\" value=\"$$language{ChangeToNo}\" />\n";
  648.             $body .= "<input type=\"hidden\" name=\"pop3_force_fork\" value=\"0\" />\n";
  649.             $body .= "<input type=\"hidden\" name=\"session\" value=\"$session_key\" />\n</form>\n";
  650.         }
  651.         $body .= "</td></tr></table>\n";
  652.     }
  653.  
  654.     return $body;
  655. }
  656.  
  657. # ---------------------------------------------------------------------------------------------
  658. #
  659. # validate_item
  660. #
  661. #    $name            The name of the item being configured, was passed in by the call
  662. #                     to register_configuration_item
  663. #    $language        Reference to the hash holding the current language
  664. #    $form            Hash containing all form items
  665. #
  666. #  Must return the HTML for this item
  667. # ---------------------------------------------------------------------------------------------
  668.  
  669. sub validate_item
  670. {
  671.     my ( $self, $name, $language, $form ) = @_;
  672.  
  673.     if ( $name eq 'pop3_port' ) {
  674.         if ( defined($$form{pop3_port}) ) {
  675.             if ( ( $$form{pop3_port} >= 1 ) && ( $$form{pop3_port} < 65536 ) ) {
  676.                 $self->config_( 'port', $$form{pop3_port} );
  677.                 return '<blockquote>' . sprintf( $$language{Configuration_POP3Update} . '</blockquote>' , $self->config_( 'port' ) );
  678.              } else {
  679.                  return "<blockquote><div class=\"error01\">$$language{Configuration_Error3}</div></blockquote>";
  680.              }
  681.         }
  682.     }
  683.  
  684.     if ( $name eq 'pop3_separator' ) {
  685.         if ( defined($$form{pop3_separator}) ) {
  686.             if ( length($$form{pop3_separator}) == 1 ) {
  687.                 $self->config_( 'separator', $$form{pop3_separator} );
  688.                 return '<blockquote>' . sprintf( $$language{Configuration_POP3SepUpdate} . '</blockquote>' , $self->config_( 'separator' ) );
  689.             } else {
  690.                 return "<blockquote>\n<div class=\"error01\">\n$$language{Configuration_Error1}</div>\n</blockquote>\n";
  691.             }
  692.         }
  693.     }
  694.  
  695.     if ( $name eq 'pop3_local' ) {
  696.         $self->config_( 'local', $$form{pop3_local}-1 ) if ( defined($$form{pop3_local}) );
  697.     }
  698.  
  699.     if ( $name eq 'pop3_secure_server' ) {
  700.          $self->config_( 'secure_server', $$form{server} ) if ( defined($$form{server}) );
  701.          return sprintf( "<blockquote>" . $$language{Security_SecureServerUpdate} . "</blockquote>", $self->config_( 'secure_server' ) ) if ( defined($$form{server}) );
  702.     }
  703.  
  704.     if ( $name eq 'pop3_secure_server_port' ) {
  705.         if ( defined($$form{sport}) ) {
  706.             if ( ( $$form{sport} >= 1 ) && ( $$form{sport} < 65536 ) ) {
  707.                 $self->config_( 'secure_port', $$form{sport} );
  708.                 return sprintf( "<blockquote>" . $$language{Security_SecurePortUpdate} . "</blockquote>", $self->config_( 'secure_port' ) ) if ( defined($$form{sport}) );
  709.             } else {
  710.                 return "<blockquote><div class=\"error01\">$$language{Security_Error1}</div></blockquote>";
  711.             }
  712.         }
  713.     }
  714.  
  715.     if ( $name eq 'pop3_force_fork' ) {
  716.         if ( defined($$form{pop3_force_fork}) ) {
  717.             $self->config_( 'force_fork', $$form{pop3_force_fork} );
  718.         }
  719.     }
  720.  
  721.     return '';
  722. }
  723.  
  724. # TODO echo_response_ that calls echo_response_ with the extra parameters
  725. # required et al.
  726.